home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE11 / CLINIC / DIRLOCKU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-27  |  3.4 KB  |  127 lines
  1. unit Dirlocku;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     DataSource1: TDataSource;
  12.     Table1: TTable;
  13.     DBGrid1: TDBGrid;
  14.     TblReadOnlyChk: TCheckBox;
  15.     TblActiveChk: TCheckBox;
  16.     DirLockChk: TCheckBox;
  17.     procedure TblActiveChkClick(Sender: TObject);
  18.     procedure TblReadOnlyChkClick(Sender: TObject);
  19.     procedure DirLockChkClick(Sender: TObject);
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormDestroy(Sender: TObject);
  22.   private
  23.     { Private declarations }
  24.   public
  25.     { Public declarations }
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. uses
  34.   DbiProcs, DbiTypes;
  35.  
  36. {$R *.DFM}
  37.  
  38. { Local share must be on in BDE Config for this to work }
  39. { To be compatible with Delphi 2 which can have databases }
  40. { open and defined in multiple sessions, the session must }
  41. { be passed along. In Delphi 1, this is simply the Session }
  42. { variable. In Delphi 2 it is the dataset's DBSession property }
  43. procedure DirectoryLock(const DatabaseName: String;
  44.   Session: TSession; LockDir: Boolean);
  45. const
  46.   DirectoryReadOnly = 'Paradox.DRO';
  47.   LockOrRel: array[Boolean] of function(hDb: hDBIDb; pszTblNam,
  48.     pszDrvType: PChar): DBIResult {$ifdef Win32}stdcall{$endif} =
  49.     (DbiRelPersistTableLock, DbiAcqPersistTableLock);
  50. begin
  51.   with Session, OpenDatabase(DatabaseName) do
  52.     try
  53.       Check(LockOrRel[LockDir](Handle, DirectoryReadOnly, szParadox));
  54.     finally
  55.       CloseDatabase(FindDatabase(DatabaseName));
  56.     end;
  57. end;
  58.  
  59. procedure TForm1.DirLockChkClick(Sender: TObject);
  60. begin
  61.   DirectoryLock(Table1.DatabaseName,
  62. {$ifdef Win32}
  63.     Table1.DBSession,
  64. {$else}
  65.     Session,
  66. {$endif}
  67.     DirLockChk.Checked);
  68. end;
  69.  
  70. procedure TForm1.TblActiveChkClick(Sender: TObject);
  71. begin
  72.   try
  73.     Table1.Active := TblActiveChk.Checked;
  74.   except
  75.     { If table can't be opened or closed, reset checkbox }
  76.     TblActiveChk.Checked := Table1.Active;
  77.     raise;
  78.   end;
  79. end;
  80.  
  81. procedure TForm1.TblReadOnlyChkClick(Sender: TObject);
  82. begin
  83.   try
  84.     Table1.Readonly := TblReadOnlyChk.Checked;
  85.   except
  86.     { If table can't be made read-only or read-write, reset checkbox }
  87.     TblReadOnlyChk.Checked := Table1.ReadOnly;
  88.     raise;
  89.   end;
  90. end;
  91.  
  92. procedure TForm1.FormCreate(Sender: TObject);
  93. var
  94.   Cfg: SysConfig;
  95. begin
  96.   { If table is open when directory lock is applied, you }
  97.   { get an unpleasant system error message. This stops it }
  98.   Tag := SetErrorMode(sem_NoOpenFileErrorBox or sem_FailCriticalErrors);
  99.   { Initialise BDE in Delphi 2, before }
  100.   { using IDAPI. Delphi 1 does this for you }
  101. {$ifdef Win32}
  102.   Session.Open;
  103. {$endif}
  104.   { Check for local share. If not on, raise exception }
  105.   Check(DbiGetSysConfig(Cfg));
  106.   if not Cfg.bLocalShare then
  107.     raise EDatabaseError.Create(
  108.       'Local share must be on for successful directory locking');
  109.   { Ensure directory is unlocked. The code assumes this is possible }
  110.   { If the database is on a CD, then it will not be possible }
  111.   try
  112.     DirectoryLock(Table1.DatabaseName, Session, False);
  113.   except
  114.     { Doesn't matter if the directory wasn't locked }
  115.   end;
  116.   DirLockChk.Checked := False;
  117.   TblActiveChk.Checked := Table1.Active;
  118.   TblReadOnlyChk.Checked := Table1.ReadOnly;
  119. end;
  120.  
  121. procedure TForm1.FormDestroy(Sender: TObject);
  122. begin
  123.   SetErrorMode(Tag);
  124. end;
  125.  
  126. end.
  127.